;;; This function will perform the same function as
;;; UREAD, but knows about E files. Note that it will
;;; work on either an E file or a non-E file.
(declare (special eread-file eread-file-stack))
(LAP SHOWIT SUBR) 
(ARGS SHOWIT (NIL . 0)) 
(MOVEI A 3)
(CALLI A 400011)
(MOVEI A 'T)
(POPJ P)
NIL 
(DECLARE (*EXPR SHOWIT) (*FEXPR UGREAT) (SPECIAL EFILEFLAG ELOADACTIONFUN
						 ELOADACTIONFUNEVALP))
(COND ((STATUS FEATURES NEWIO)
       (defprop ugreat (direct fas dsk (mac lsp)) autoload))
      (t 
       (defprop ugreat (direct fas dsk (old lsp)) autoload)))
(macrodef push (x) (setq pdl (cons x pdl)))
(macrodef pop () (setq file (cdr file)))
(macrodef check () (cond ((null file)(throw (nreverse pdl) out))))
(macrodef default (file)
(cond (file
 (catch (prog (pdl)
	 (push (car file))
	 (pop)
	 (push (cond ((or (null file)
			  (memq (car file) '(dsk sys))
		   	  (not (atom (car file)))) '|←←←|)
		     (t (prog2 nil (car file) (pop)))))
	 (check)
	 (push (cond ((atom (car file)) (prog2 nil (car file)(pop)))
		     (t 'dsk)))
	 (check)
	 (push (cond ((= (length (car file)) 2)(car file))
		     (t (list (caar file)(cadr (status udir))))))
	 (throw (nreverse pdl) out))
  out))))

(SETQ ELOADACTIONFUN ())

(SETQ ELOADACTIONFUNEVALP T)

(DECLARE (SPECIAL EREAD))

(defun %uread% fexpr (filename)
       (UCLOSE)
       ((LAMBDA (FILE)
		(EOFFN FILE
		       (FUNCTION
			(LAMBDA (EOFFILE EOFVAL)
				(UCLOSE)
				EOFVAL)))
		(INPUSH (SETQ UREAD FILE))
		(DEFAULTF FILE))
	(EOPEN FILENAME 'IN)))
 
(DEFUN EREAD FEXPR (FILE) 
       ((LAMBDA (↑Q FILE) 
		(COND ((NULL FILE)
		       (SETQ FILE (AND (BOUNDP 'EREAD)
				       EREAD)))
		      (T (SETQ EREAD FILE))) 
	 (COND ((EQ (CADR FILE) '/>)
		(RPLACA (CDR FILE) 
			     (APPLY 'UGREAT (CONS (CAR FILE)
						  (OR (CADDDR FILE)
						      (CADR (STATUS CRUNIT))))))) 
	       ((EQ (CADR FILE) '/ )
		(RPLACA (CDR FILE) '|←←←|)))
	 (APPLY (FUNCTION %UREAD%) FILE)
			 (SETQ EREAD-FILE UREAD)
			 (SETQ ↑Q T EFILEFLAG NIL)
			 ;;; All E files have C as the first character
			 (COND ((NOT (= (TYIPEEK) 67.)))
			 ;;; Look for COMMENT ⊗ VALID
			       ((AND (EQ (READ) 'COMMENT)
				     (EQ (READ) '⊗)
				     (EQ (READ) 'VALID))
				;;; Skip to end of directory
			  	(SETQ EFILEFLAG T)
				(DO I NIL NIL (= (TYI) 22.))
				(DO I NIL NIL (= (TYI) 12.)))
			       ;;; Looked like an E file for a while.
			       (T (APPLY (FUNCTION %UREAD%) FILE)))
			 )
	↑Q (DEFAULT FILE)
	)
	(SHOWIT)
       (STATUS CRUNIT))

(declare (*expr defaultf)(*fexpr code))


(setq eread-file-stack ())

(macrodef push-eread-stack () 
	  (setq eread-file-stack 
		(cons eread-file eread-file-stack)))

(macrodef pop-eread-stack ()
	  (setq eread-file (car eread-file-stack)
		eread-file-stack (cdr eread-file-stack)))

(defun eload (file)
 ((lambda (the-file)
 (cond ((status nofeatures newio)
	(error '|Cannot ELOAD in OLDIO| file 'fail-act)))
 (cond ((atom (car file)))
       (t (setq 
	   file 
	   (list (cadr file)
		 (or (caddr file)
			'|←←←|)
		 (or (caar file) '*)
		 (or (cadar file) (list '* '*))))))  
 (setq file (default file))
 (cond ((null file)
	(setq file (and (boundp 'eread)
			eread)))
       (t (setq eread file)))
 (cond ((eq (cadr file) '/>)
	(rplaca (cdr file)
		(apply 'ugreat (cons (car file) (or (cadddr file)
						    (cadr (status crunit))))))))  
((lambda (eread-file eof)
	 (push-eread-stack)
	 (eoffn eread-file
		(function 
		 (lambda (eoffile eofval)
			 (close eread-file)
			 (inpush -1)
			 (pop-eread-stack)
			 eofval))) 
	 (unwind-protect 
	  (do ((form (read eread-file eof)(read eread-file eof)))
	      ((eq form eof) (close eread-file))
	      
	      (cond (eloadactionfun
		     (cond (eloadactionfunevalp
			    (eval (funcall eloadactionfun form)))
			   (t (funcall eloadactionfun form))))
		    (t (eval form)))) 
	  (close eread-file)))
 (eopen (defaultf file))
 (ncons nil))     
 the-file ) file)  )

(defun el fexpr (file) (eload (or file eread)))

(defun mel fexpr (file) (let eloadactionfun ← 'macro-expand 
			     eloadactionfunevalp ← t do
			     (eload (or file eread))))

(defun early-terminate ()
 (close eread-file)
 (pop-eread-stack)
 (inpush -1))

(defprop macro-expand (macex fas dsk (mac lsp)) autoload)

(defun edel fexpr (file) (let eloadactionfun ← '%evaluate 
			     eloadactionfunevalp ← () do
			     (eload (or file eread))))